Network Analysis en R
Tenemos esta información:
1. Importando datos
FileName='dataFigueroa.csv'
adjacency=read.csv(FileName)El formato es una matriz de adyacencia, por lo que debería ser cuadrada:
dim(adjacency)## [1] 37 39Sucede que la ultima columna es un atributo, y la primera repite los apellidos:
names(adjacency)## [1] "Names" "Romero" "Grana"
## [4] "Miro.Quesada" "Moreyra" "Fort"
## [7] "De.La.Puente" "Wiese" "Onrubia"
## [10] "Brescia" "Nicolini" "Montero"
## [13] "Picaso" "Bentin" "Benavides"
## [16] "Bustamante" "Woodman.Pollit" "Raffo"
## [19] "Piazza" "Berckemeyer" "Llosa.Barber"
## [22] "Beoutis.Ledesma" "Rizo.Patron" "Montori"
## [25] "Sotomayor" "Cilloniz" "Ferreyros"
## [28] "Michell" "Wong.Lu" "Batievsky.Spack"
## [31] "Matos.Escalada" "Galsky" "Lucioni"
## [34] "Rodriguez.Rodriguez" "Custer" "Ikeda"
## [37] "Cogorno" "Arias.Davila" "multinational"Guardemos apellidos y atributo:
attributes=adjacency[,c('Names','multinational')]
head(attributes)## Names multinational
## 1 Romero 1
## 2 Grana 1
## 3 Miro Quesada 1
## 4 Moreyra 1
## 5 Fort 1
## 6 De La Puente 1Pasemos el atributo a categoría:
attributes$multinational=factor(attributes$multinational,levels = c(0,1),labels = c("No", "Si"),ordered = F)Ahora, pasemos Names como nombre de fila:
row.names(adjacency)=adjacency$Names
adjacency$Names=NULL
adjacency$multinational=NULL
# asi:
head(adjacency)## Romero Grana Miro.Quesada Moreyra Fort De.La.Puente Wiese Onrubia
## Romero 0 1 1 1 1 1 0 1
## Grana 1 0 1 0 1 1 1 0
## Miro Quesada 1 1 0 0 1 1 1 0
## Moreyra 1 0 0 0 1 1 1 1
## Fort 1 1 1 1 0 1 0 1
## De La Puente 1 1 1 1 1 0 1 0
## Brescia Nicolini Montero Picaso Bentin Benavides Bustamante
## Romero 1 1 0 0 1 1 1
## Grana 0 0 1 0 0 1 1
## Miro Quesada 0 0 1 0 0 1 1
## Moreyra 1 0 1 1 1 0 1
## Fort 1 1 0 1 1 1 1
## De La Puente 0 0 1 0 0 1 1
## Woodman.Pollit Raffo Piazza Berckemeyer Llosa.Barber
## Romero 1 1 1 1 1
## Grana 0 0 1 0 0
## Miro Quesada 0 0 1 0 0
## Moreyra 0 1 0 1 0
## Fort 1 1 1 0 1
## De La Puente 0 0 1 1 0
## Beoutis.Ledesma Rizo.Patron Montori Sotomayor Cilloniz Ferreyros
## Romero 0 1 1 0 0 0
## Grana 1 0 0 0 0 0
## Miro Quesada 1 0 0 0 0 0
## Moreyra 0 1 1 1 0 0
## Fort 1 0 0 1 1 0
## De La Puente 1 1 0 1 0 0
## Michell Wong.Lu Batievsky.Spack Matos.Escalada Galsky Lucioni
## Romero 0 0 0 0 0 0
## Grana 1 0 0 0 0 0
## Miro Quesada 1 0 0 0 0 0
## Moreyra 0 0 0 0 0 0
## Fort 0 0 0 0 0 0
## De La Puente 0 0 0 0 0 0
## Rodriguez.Rodriguez Custer Ikeda Cogorno Arias.Davila
## Romero 0 0 0 0 0
## Grana 0 0 0 0 0
## Miro Quesada 0 0 0 0 0
## Moreyra 0 0 0 0 0
## Fort 0 0 0 0 0
## De La Puente 0 0 0 0 0Nota que la estructura es data frame:
class(adjacency)## [1] "data.frame"Pasemosla a matriz.
adjacency=as.matrix(adjacency) Llevemos la matriz a grafo con la ayuda de Igraph:
library(igraph)
EliteNet=graph.adjacency(adjacency,mode="undirected",weighted=NULL)
# see it here
EliteNet## IGRAPH 9371efd UN-- 37 135 --
## + attr: name (v/c)
## + edges from 9371efd (vertex names):
## [1] Romero--Grana Romero--Miro.Quesada Romero--Moreyra
## [4] Romero--Fort Romero--De.La.Puente Romero--Onrubia
## [7] Romero--Brescia Romero--Nicolini Romero--Bentin
## [10] Romero--Benavides Romero--Bustamante Romero--Woodman.Pollit
## [13] Romero--Raffo Romero--Piazza Romero--Berckemeyer
## [16] Romero--Llosa.Barber Romero--Rizo.Patron Romero--Montori
## [19] Grana --Miro.Quesada Grana --Fort Grana --De.La.Puente
## [22] Grana --Wiese Grana --Montero Grana --Benavides
## + ... omitted several edgesUn grafo está compuesto de nodos o vertices, y edges o enlaces que los conectan, Aquí podemos ver cuántos hay de cada uno:
vcount(EliteNet) #conteo de nodos## [1] 37ecount(EliteNet) #conteo de enlaces## [1] 135Gráficamente:
plot.igraph(EliteNet,
vertex.color = 'yellow',
edge.color='lightblue')
Añadimos los atributos:
EliteNet=set_vertex_attr(EliteNet,"multi",value=attributes$multinational)
#then
EliteNet## IGRAPH 9371efd UN-- 37 135 --
## + attr: name (v/c), multi (v/n)
## + edges from 9371efd (vertex names):
## [1] Romero--Grana Romero--Miro.Quesada Romero--Moreyra
## [4] Romero--Fort Romero--De.La.Puente Romero--Onrubia
## [7] Romero--Brescia Romero--Nicolini Romero--Bentin
## [10] Romero--Benavides Romero--Bustamante Romero--Woodman.Pollit
## [13] Romero--Raffo Romero--Piazza Romero--Berckemeyer
## [16] Romero--Llosa.Barber Romero--Rizo.Patron Romero--Montori
## [19] Grana --Miro.Quesada Grana --Fort Grana --De.La.Puente
## [22] Grana --Wiese Grana --Montero Grana --Benavides
## + ... omitted several edgestienes:
vertex_attr_names(EliteNet) ## [1] "name" "multi"Esta red estará “conectada”:
is_connected(EliteNet)## [1] FALSECuantos “componentes”?
components(EliteNet)$no## [1] 8Quienes en cada componente:
groups(components(EliteNet))## $`1`
## [1] "Romero" "Grana" "Miro.Quesada" "Moreyra"
## [5] "Fort" "De.La.Puente" "Wiese" "Onrubia"
## [9] "Brescia" "Nicolini" "Montero" "Picaso"
## [13] "Bentin" "Benavides" "Bustamante" "Woodman.Pollit"
## [17] "Raffo" "Piazza" "Berckemeyer" "Llosa.Barber"
## [21] "Beoutis.Ledesma" "Rizo.Patron" "Montori" "Sotomayor"
## [25] "Cilloniz" "Ferreyros" "Michell" "Wong.Lu"
##
## $`2`
## [1] "Batievsky.Spack" "Matos.Escalada" "Galsky"
##
## $`3`
## [1] "Lucioni"
##
## $`4`
## [1] "Rodriguez.Rodriguez"
##
## $`5`
## [1] "Custer"
##
## $`6`
## [1] "Ikeda"
##
## $`7`
## [1] "Cogorno"
##
## $`8`
## [1] "Arias.Davila"Componente como atributo:
component=components(EliteNet)$membership
EliteNet=set_vertex_attr(EliteNet,"component",value=component)
#asi:
EliteNet## IGRAPH 9371efd UN-- 37 135 --
## + attr: name (v/c), multi (v/n), component (v/n)
## + edges from 9371efd (vertex names):
## [1] Romero--Grana Romero--Miro.Quesada Romero--Moreyra
## [4] Romero--Fort Romero--De.La.Puente Romero--Onrubia
## [7] Romero--Brescia Romero--Nicolini Romero--Bentin
## [10] Romero--Benavides Romero--Bustamante Romero--Woodman.Pollit
## [13] Romero--Raffo Romero--Piazza Romero--Berckemeyer
## [16] Romero--Llosa.Barber Romero--Rizo.Patron Romero--Montori
## [19] Grana --Miro.Quesada Grana --Fort Grana --De.La.Puente
## [22] Grana --Wiese Grana --Montero Grana --Benavides
## + ... omitted several edgesGraficamente:
Labels=component
numberOfClasses = length(unique(Labels))
#preparando color
library(RColorBrewer)
colorForScale='Set2'
colors = brewer.pal(numberOfClasses, colorForScale)
# graficando
plot.igraph(EliteNet,
vertex.color = colors[Labels],
edge.color='lightblue')
Quedemonos con el Giant Component:
- conteos:
(Sizes=components(EliteNet)$csize)## [1] 28 3 1 1 1 1 1 1- eligiendo:
EliteNet_giant=induced.subgraph(EliteNet, which(Labels == which.max(Sizes)))veamos al Giant Component:
plot.igraph(EliteNet_giant)
Resumen:
summary(EliteNet_giant)## IGRAPH 8431446 UN-- 28 133 --
## + attr: name (v/c), multi (v/n), component (v/n)2. Exploración
Metricas totales:
- Densidad (Density): va de 0 a 1. 1 significa que hay un link entre cada par de nodos.
graph.density(EliteNet_giant)## [1] 0.3518519- Diameter: El mayor de los geodesicos (el sendero(path) menor entre cualquier par de nodos)
diameter(EliteNet_giant)## [1] 4- El coeficiente de agrupamiento (clustering coefficient) cuantifica qué tanto está agrupado un nodo con sus vecinos. Si está conectado con todos es 1. Así, coeficiente de agrupamiento local es el promedio de esos valores.
transitivity(EliteNet_giant,type = 'average')## [1] 0.6537019- Shortest path (average): es el promedio de todos los senderos menores de la red.
average.path.length(EliteNet_giant)## [1] 1.740741Random networks tienen pequeños shortest path and pequeño clustering coefficient.
- Transitivity: qué tan probable es que dos nodes con algun contacto en común tambíen estén conectados.
transitivity(EliteNet_giant)## [1] 0.5829694- Assortativity (degree): Mide la tendencia a conectarse con nodos de grado similar. Mientras mas cerca a 1 hay mayor assortativity, mas cerca a -1 diassortativity; pero 0 es ausencia de assortitivity.
assortativity_degree(EliteNet_giant)## [1] -0.1208671No solo para grado de conexiones, sino otro atributo:
attrNet=V(EliteNet_giant)$multi
assortativity_nominal(EliteNet_giant,attrNet)## [1] -0.07258065Coloreando por atributo:
LabelsColor=attrNet
colors=c('lightblue','magenta')
plot.igraph(EliteNet_giant,
vertex.color = colors[LabelsColor])
Comunidades
- La red presenta cliques? (conjunto de nodos donde todos están conectados mutuamente)
length(cliques(EliteNet_giant))## [1] 1074Un clique puede estar anidado. Si un clique no puede crecer más (dejando de ser clique): maximal clique.
- Cuántos maximal cliques?
count_max_cliques(EliteNet_giant)## [1] 28Tamaño del maximal clique:
clique_num(EliteNet_giant)## [1] 8- Cuales son los más grandes?
max_cliques(EliteNet_giant,min=8)## [[1]]
## + 8/28 vertices, named, from 8431446:
## [1] Onrubia Romero Raffo Bentin Fort
## [6] Llosa.Barber Woodman.Pollit Nicolini
##
## [[2]]
## + 8/28 vertices, named, from 8431446:
## [1] Onrubia Romero Raffo Bentin Berckemeyer Montori
## [7] Brescia Moreyra
##
## [[3]]
## + 8/28 vertices, named, from 8431446:
## [1] Benavides Romero Piazza Bustamante De.La.Puente
## [6] Fort Miro.Quesada GranaSi hay cliques, es claro que hay comunidades. Detectar comunidades es un área enorme de investigación, usemos uno de los algoritmos conocido como el método Louvain.
communities=cluster_louvain(EliteNet_giant)
(partition=membership(communities))## Romero Grana Miro.Quesada Moreyra Fort
## 2 1 1 3 1
## De.La.Puente Wiese Onrubia Brescia Nicolini
## 1 3 2 2 2
## Montero Picaso Bentin Benavides Bustamante
## 1 3 2 1 1
## Woodman.Pollit Raffo Piazza Berckemeyer Llosa.Barber
## 2 2 1 2 2
## Beoutis.Ledesma Rizo.Patron Montori Sotomayor Cilloniz
## 1 3 2 3 3
## Ferreyros Michell Wong.Lu
## 1 1 2Ahora, usamos esos valores para resaltar las comunidades:
Labels=partition
numberOfClasses = length(unique(Labels))
library(RColorBrewer)
colorForScale='Set2'
colors = brewer.pal(numberOfClasses, colorForScale)
plot.igraph(EliteNet_giant,
vertex.color = colors[Labels],
edge.color='lightblue')
Exploración de actores de la red
Prestemos atención a los individuos de la red. Calculemos:
- El grado o degree de un nodo: la cantidad de enlaces que inciden en él.
- La cercania o closeness: Se basa en calcular la suma o bien el promedio de las distancias geodésicas (o longitudes de los caminos más cortos) desde un nodo hacia todos los demás.
- La intermediación o betweenness:que cuantifica la frecuencia o el número de veces que un nodo se encuentra entre las geodésicas o caminos más cortos de otros actores.
rounding=3
degr=round(degree(EliteNet_giant,normalized=T),rounding)
close=round(closeness(EliteNet_giant,normalized=T),rounding)
betw=round(betweenness(EliteNet_giant,normalized=T),rounding)
DFCentrality=as.data.frame(cbind(degr,close,betw),stringsAsFactors = F)
names(DFCentrality)=c('Degree','Closeness','Betweenness')DFCentrality$person=row.names(DFCentrality)
row.names(DFCentrality)=NULL
head(DFCentrality)## Degree Closeness Betweenness person
## 1 0.667 0.750 0.102 Romero
## 2 0.407 0.614 0.043 Grana
## 3 0.407 0.614 0.043 Miro.Quesada
## 4 0.556 0.675 0.066 Moreyra
## 5 0.704 0.771 0.155 Fort
## 6 0.519 0.659 0.039 De.La.PuenteGraficamente:
library(ggplot2)
ggplot(DFCentrality, aes(x=Betweenness, y=Closeness)) + theme_classic()+
scale_size(range = c(1, 25)) + geom_text(aes(label=person,color=Degree)) +
scale_colour_gradient(low = "orange", high = "black")
El nodo con el mayor degree se puede considerar un hub de la red:
DFCentrality[which.max(DFCentrality$Degree),]## Degree Closeness Betweenness person
## 5 0.704 0.771 0.155 FortVeamos la red del hub, o su ego network:
- Determiner el nombre del hub:
#who
hub=DFCentrality[which.max(DFCentrality$Degree),]$person- Determinar la posición del hub:
#where
hubix=as.numeric(row.names(DFCentrality[DFCentrality$person==hub,]))- Pedir la red ego del hub:
HubEgonets=make_ego_graph(EliteNet_giant, nodes=hubix)
# HubEgonets es una list, pedimos el primer elemento:
HubEgonet=HubEgonets[[1]]- Just plot the ego you got:
egoSizes=rep(5,vcount(HubEgonet)) # tamaño de todos
egoSizes[hubix]=40 # tamaño del ego
V(HubEgonet)$size=egoSizes
plot.igraph(HubEgonet,
vertex.color = 'yellow',
edge.color='lightblue')
Podríamos partir el giant component?
Numero mínimo de nodos para desconectarlo:
vertex_connectivity(EliteNet_giant)## [1] 1quienes la pueden partir?
articulation_points(EliteNet_giant)## + 1/28 vertex, named, from 8431446:
## [1] BentinV(EliteNet_giant)$color = ifelse(V(EliteNet_giant) %in%
articulation_points(EliteNet_giant),
"salmon", "lightblue")
V(EliteNet_giant)$size = ifelse(V(EliteNet_giant) %in%
articulation_points(EliteNet_giant),
40, 10)
plot.igraph(EliteNet_giant,
edge.color = 'yellow',
vertex.shape='sphere')
Exportando la red
write_graph(EliteNet, "EliteNetR.graphml", "graphml")